home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Icon 8.1 / mep2 / MemMon 2.0 / Samples / memsum.icn < prev    next >
Encoding:
Text File  |  1990-01-04  |  5.7 KB  |  204 lines  |  [TEXT/PICN]
  1. #  This program is a filter for Icon allocation history files. It tabulates
  2. #  the number of allocations by type and the total amount of storage
  3. #  (in bytes) by type.
  4. #
  5. #  It takes an Icon allocation history file from standard input and writes to
  6. #  standard output.  There is a command-line option -d that produces
  7. #  some debugging output.
  8. #
  9. #  At the moment, it's still a bit ad hoc and inevitably incomplete.
  10. #
  11. #  Some assumptions are made about where newlines occur -- specifically
  12. #  that verification commands are on single lines and that refresh and
  13. #  garbage collection data are on multiple lines.
  14. #
  15.  
  16. global cmds, highlights, lastlen, alloccnt, alloctot, collections
  17. global mmunits, diagnose
  18.  
  19. procedure main(opts)
  20.  
  21.    diagnose := if opts[1] == "-d" then write else 1
  22.  
  23.    cmds := 'cefLlRrSsTtux"XAF'        # command characters
  24.    highlights := '%$Y'            # highlight commands
  25.    mmunits := 4                # (for most systems)
  26.  
  27.    lastlen := table()            # last size
  28.    alloccnt := table(0)            # count of allocations
  29.    alloctot := table(0)            # total allocation
  30.    collections := list(4,0)        # garbage collection counts
  31.  
  32.    every alloccnt[!cmds] := 0
  33.    every alloctot[!cmds] := 0
  34.  
  35.    cmds ++:= highlights
  36.  
  37.    while line := read() do {        # input from MemMon history file
  38.       line ? {                # note: coded for extensions
  39.          if region := tab(upto('{')) then {    # skip refresh sequence
  40.             collections[region] +:= 1
  41.             while line := read() | stop("**** premature eof") do
  42.                line ? if upto('#!') then break next
  43.             }
  44.          case move(1) of {
  45.  
  46.             "=": next            # skip verification command
  47.             "#": next            # skip comment
  48.             "<": {            # skip refresh sequence
  49.                while line := read() | stop("**** premature eof") do
  50.                   line ? if upto('#>') then break next
  51.                }
  52.             ";": next            # skip pause command
  53.             "!" | ">": next        # resynchronize (edited file)
  54.  
  55.             default: {            # data to process
  56.                move(-1)            # back off from move(1) above
  57.                if mmuits := integer(tab(upto('<'))) then {
  58.                   while line := read() | stop("**** premature eof") do
  59.                      line ? if upto('#>') then break next
  60.                   }
  61.                else {
  62.                   repeat {            # process allocation
  63.                      tab(many(' '))    # skip blanks (old files)
  64.                      if pos(0) then break next
  65.                      skip := process(tab(upto(cmds) + 1)) |
  66.                         stop("*** unexpected data: ",line)
  67.                      move(skip)
  68.                      }
  69.                   }
  70.                }
  71.             }
  72.          }
  73.       }
  74.  
  75.    display()
  76.  
  77. end
  78.  
  79. #  Display a table of allocation data
  80. #
  81. procedure display()
  82.  
  83.    static namemap
  84.    static col1, col2, gutter        # column widths
  85.  
  86.    initial {                # map of codes to type names
  87.       namemap := table("*** undefined ***")
  88.       namemap["c"] := "cset"
  89.       namemap["e"] := "table element tv"
  90.       namemap["f"] := "file"
  91.       namemap["L"] := "list header"
  92.       namemap["l"] := "list element"
  93.       namemap["R"] := "record"
  94.       namemap["r"] := "real number"
  95.       namemap["S"] := "set header"
  96.       namemap["s"] := "set element"
  97.       namemap["T"] := "table header"
  98.       namemap["t"] := "table element"
  99.       namemap["u"] := "substring tv"
  100.       namemap["x"] := "refresh block"
  101.       namemap["\""] := "string"
  102.       namemap["X"] := "co-expression"
  103.       namemap["A"] := "alien block"
  104.       namemap["F"] := "free space"
  105.  
  106.       col1 := 16            # name field
  107.       col2 := 10            # number field
  108.       gutter := repl(" ",6)
  109.       }
  110.  
  111.    write(,                # write column headings
  112.       "\n",
  113.       left("type",col1),
  114.       right("number",col2),
  115.       gutter,
  116.       right("bytes",col2),
  117.       gutter,
  118.       right("average",col2),
  119.       gutter,
  120.       right("% bytes",col2),
  121.       "\n"
  122.       )
  123.  
  124.    alloccnt := sort(alloccnt,3)                # get the data
  125.    alloctot := sort(alloctot,3)
  126.  
  127.    cnttotal := 0
  128.    tottotal := 0
  129.  
  130.    every i := 2 to *alloccnt by 2 do {
  131.       cnttotal +:= alloccnt[i]
  132.       tottotal +:= alloctot[i]
  133.       }
  134.  
  135.    while write(                        # write the data
  136.       left(namemap[get(alloccnt)],col1),        # name
  137.       right(cnt := get(alloccnt),col2),            # number of allocations
  138.       gutter,
  139.       get(alloctot) & right(tot := get(alloctot),col2),    # space allocated
  140.       gutter,
  141.       fix(tot,cnt,col2),
  142.       gutter,
  143.       fix(100.0 * tot,tottotal,col2)
  144.       )
  145.  
  146.    write(                        # write totals
  147.       "\n",
  148.       left("total:",col1),
  149.       right(cnttotal,col2),
  150.       gutter,
  151.       right(tottotal,col2),
  152.       gutter,
  153.       fix(tottotal,cnttotal,col2)
  154.       )
  155.  
  156.    totalcoll := 0                    # garbage collections
  157.    every totalcoll +:= !collections
  158.    write("\n",left("collections:",col1),right(totalcoll,col2))
  159.    if totalcoll > 0 then {
  160.       write(left("  static region:",col1),right(collections[1],col2))
  161.       write(left("  string region:",col1),right(collections[2],col2))
  162.       write(left("  block region:",col1),right(collections[3],col2))
  163.       wr}
  164.  
  165.    return
  166. end
  167.  
  168. #  Process datm
  169. #
  170. procedure process(s)
  171.  
  172.    s ? {
  173.       tab(upto('+') + 1)        # skip address
  174.       len := tab(many(&digits)) | &null
  175.       cmd := move(1)
  176.  
  177.       if cmd == !highlights then return 2 else {
  178.                        # if given len is nonstring, scale
  179.          if cmd ~== "\"" then \len *:= mmunits
  180.          alloccnt[cmd] +:= 1
  181.          (/len := lastlen[cmd]) | (lastlen[cmd] := len)
  182.          diagnose(&errout,"cmd=",cmd,", len=",len)
  183.          alloctot[cmd] +:= len
  184.          return 0
  185.          }
  186.       }
  187. end
  188.  
  189. #  Format floating-point number.
  190. #
  191. procedure fix(i,j,w)
  192.  
  193.    if j = 0 then return repl(" ",w)
  194.    r := real(i) / j
  195.    if r < 0.001 then return repl(" ",w - 5) || "0.000"
  196.    string(r) ? {
  197.       int := tab(upto('.'))
  198.       &pos +:= 1
  199.       dec := tab(0)
  200.       }
  201.    return right(int,w - 4) || "." || left(dec,3,"0")
  202.  
  203. end
  204.